home *** CD-ROM | disk | FTP | other *** search
/ Packard Bell - Internet on a CD / internet on a cd.cdr / Internet / sites / Clementine_NASA / image.hqx / Image folder / CLEM Macros < prev    next >
Encoding:
Text File  |  1994-08-30  |  4.0 KB  |  165 lines
  1. procedure findkeyword(start,stop:integer);
  2. var
  3.   d, i:integer;
  4. begin
  5.   i := start;
  6.   while (GetPixel(i,0) <> 13) and (GetPixel(i,0) <> 10) and (i< stop) do i := i+1; 
  7.   while (GetPixel(i,0) <=  32) and (i < stop) do i := i+1;
  8.   keyloc := i;
  9. end;
  10.  
  11. procedure findvalue(start,stop:integer);
  12. var
  13.   d, i, m:integer;
  14. begin
  15.   i := start;
  16.   while (GetPixel(i,0) <> 61) and (i < stop) do i := i+1;
  17.   i := i+1;
  18.   while (GetPixel(i,0) =  32) and (i < stop) do i := i+1;
  19.   valloc := i; 
  20.   while (GetPixel(i,0) > 32) and (i < stop) do i := i+1;
  21.   valend := i-1;
  22.  end;
  23.  
  24. procedure getint(start,stop:integer);
  25. var
  26.   i,m:integer;
  27. begin
  28.   m := 1;
  29.   for i:= start to stop-1 do begin
  30.     m:= m*10;
  31.   end;
  32.   
  33.   value := 0;
  34.   for i:= start to stop do begin
  35.    d := GetPixel(i,0);
  36.    if d=32 then d:=48;
  37.    if (d<48) or (d>57) then 
  38.         begin
  39.         PutMessage('This macro only reads PDS images with attached labels.');
  40.         Dispose(nPics);
  41.         exit;
  42.         end;
  43.    d:= d-48;
  44.    value:=value+d*m;
  45.    m:=m/10;
  46.   end;
  47.  
  48. end;
  49.  
  50. macro 'Import PDS';
  51. {
  52. This macro will display PDS images with attached labels.
  53. }
  54. var
  55.   width,height,offset,off,i,j,d,m,keyloc,valloc,valend,value:integer;
  56. begin
  57.   width:=500; 
  58.   height:=1;
  59.   off:=0;
  60.   SetImport('8-bit'); 
  61.   SetCustom(width,height,off);
  62.   Import(''); {Read in header as an image, prompting for the file name.}
  63.   {check to see if CCSD or NJPL or PDS otherwise quit}
  64.   if ((GetPixel(0,0) = 67) and (GetPixel(1,0) = 67) and 
  65.      (GetPixel(2,0) = 83) and (GetPixel(3,0) = 68)) or
  66.      ((GetPixel(0,0) = 78) and (GetPixel(1,0) = 74) and 
  67.      (GetPixel(2,0) = 80) and (GetPixel(3,0) = 76)) or
  68.      ((GetPixel(0,0) = 80) and (GetPixel(1,0) = 68) and
  69.      (GetPixel(2,0) = 83))
  70.   then begin 
  71.      i:=0;
  72.   end
  73.   else begin
  74.      PutMessage('This macro only reads PDS images.');
  75.      Dispose(nPics);
  76.      exit;
  77.   end;
  78.   
  79.   {get the offset from the browse_image keyword}
  80.   i := 0; j := 500; valloc := 1; keyloc := 0;
  81.   findkeyword(i,j);
  82.   repeat
  83.   i := keyloc;
  84.   if (GetPixel(i,0) = 94) and (GetPixel(i+1,0) = 66) and 
  85.      (GetPixel(i+2,0) = 82) and (GetPixel(i+3,0) = 79) and 
  86.      (GetPixel(i+4,0) = 87) and (GetPixel(i+8,0) = 73)
  87.   then begin
  88.      findvalue(i,j);
  89.   end
  90.   else begin
  91.      i := i+1;
  92.      findkeyword(i,j);
  93.   end;
  94.   until (valloc > 2) and (valloc < 499) or (keyloc >= 499);
  95.   getint(valloc,valend);
  96.   offset := value - 1;
  97.        
  98.   if (offset <= 0) then begin
  99.   {get the offset from the image keyword }
  100.   i := 0; j := 500; valloc := 1; keyloc:=0;
  101.   findkeyword(i,j);
  102.   repeat
  103.   i := keyloc;
  104.   if (GetPixel(i,0) = 94) and (GetPixel(i+1,0) = 73) and 
  105.      (GetPixel(i+2,0) = 77) and (GetPixel(i+6,0) <> 95) 
  106.   then begin 
  107.      findvalue(i,j);
  108.   end
  109.   else begin
  110.      i := i+1;
  111.      findkeyword(i,j);
  112.   end;
  113.   until (valloc > 2) and (valloc < 499) or (keyloc >= 499);
  114.   {if the location contains non-numeric " or ' then print message does 
  115.    not work with detached labels.}
  116.   getint(valloc,valend);
  117.   offset := value - 1;
  118.   end;
  119.  
  120.   off:=3900;
  121.   Dispose(nPics);
  122.   SetCustom(width,height,off);
  123.   Import('');
  124.  
  125.   {get the width from the line_samples keyword }
  126.   i:=0; j:=500; valloc:=1; keyloc:=0;
  127.   findkeyword(i,j);
  128.   repeat
  129.   i := keyloc;
  130.   if (GetPixel(i,0) = 76) and (GetPixel(i+1,0) = 73) and 
  131.      (GetPixel(i+2,0) = 78) and (GetPixel(i+5,0) = 83) 
  132.   then begin 
  133.      findvalue(i,j);
  134.   end
  135.   else begin
  136.     findkeyword(i,j);
  137.   end;
  138.   until (valloc > 2) and (valloc < 499) or (keyloc >= 499);
  139.   getint(valloc,valend);
  140.   width := value;
  141.   
  142.   {get the height from the lines keyword }
  143.   i:=0; j:=500; valloc:=1; keyloc:=0;
  144.   findkeyword(i,j);
  145.   repeat
  146.   i := keyloc;
  147.   if (GetPixel(i,0) = 76) and (GetPixel(i+1,0) = 73) and 
  148.      (GetPixel(i+2,0) = 78) and (GetPixel(i+4,0) = 83) 
  149.   then begin 
  150.      findvalue(i,j);
  151.   end
  152.   else begin
  153.      i := i+1;
  154.      findkeyword(i,j);
  155.   end;
  156.   until (valloc > 2) and (valloc < 499) or (keyloc >= 499);
  157.   getint(valloc,valend);
  158.   height := value;
  159.  
  160.   Dispose(nPics);  {The ID of the last window opened is equal to nPics.}
  161.   SetImport('8-bit');
  162.   SetCustom(width,height,offset);
  163.   Import('');  {No prompt this time; Import remembers the name.}
  164. end;
  165.